perm filename JUSTFY.F4[NEW,LCS]9 blob sn#390611 filedate 1978-10-20 generic text, type T, neo UTF8
C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
	SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
CC	IMPLICIT INTEGER(A-Q,S-Z)
CC	REAL EXTEN,PRCNT,ACCX,SPFAC
	COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
CC	COMMON /STF/RSTFAC(0/7),RSTJ2 /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
	DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
	DATA RBX/6.0/,RBZ/8.0/
CC	DATA RSP/.5/,RI/4.5/
CC	RSP=.5
	SPFAC=.5
	DO 11 KN=0,JLP
	RSPC=0
	R8=KN
	N=0

	DO 2 K=1,KY
	L=NP(K)
	RL=RN(L)
C  RL=WDCNT-2
	RA=RN(L+1)
C  RA=CODE NUM.
	RB=RN(L+3)
C  RB=POSITION(P3)
	IF(RN(L+2).EQ.R8)GO TO 77
C  THIS STAFF?
	IF(RA.NE.4)GO TO 2
C  SKIPS HOMED NOTES (IN CHORDS)
77	IF(RA.LT.3)GO TO 20
	IF(RA.EQ.4)GO TO 444
	IF(RA.EQ.3)GO TO 333
C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
	IF(RA.LT.17)GO TO 2
	GO TO 10
333	IF(RL.LT.3)GO TO 10
C  <3 MEANS NOTHING IN P5
	IF(RN(L+5).GT.4)GO TO 2
C  NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
	GO TO 10
444	IF(RL.GT.3)GO TO 2
CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
	GO TO 10
20	IF(RA.NE.2)GO TO 113
C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
	IF(RN(L+6))GO TO 2
	IF(RN(L+7))GO TO 2
C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
	GO TO 10
113	IF(RL.LT.7)GO TO 10
C NOW NOTES.  SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
	IF(RN(L+9).LT.0)GO TO 2
10	N=N+1
	R(1,N)=RB
	IR(2,N)=L
	IF(N.EQ.250)GO TO 28
C  ONLY TREATS 250 ITEMS AT A TIME.
2	CONTINUE

	IF(N.EQ.0)GO TO 11
28	DO 23 K=1,N
23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
C  SKIPS IF ONLY BAR LINES ON THIS STAFF
	GO TO 11
24	RSZ=RSTFAC(KN)*PRCNT
	CALL SORT2(R,N)

C  JUMP IF LAST IS A BAR LINE.
	K=0
	JLDGR=0
     	JX=0
22	K=K+1
122	L=IR(2,K)
	RA=RN(L+1)
C  RA IS NOW CODE NUM.
	RL=RN(L)
C  RL=WDCNT-2
	RB=0
	RD=0
C  RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
	RX=RN(L+5)
C  RX=PARAM 5
	RX6=RN(L+6)
	RY=1
	RW=AMOD(RN(L+4),100.)
	RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
	IF(RA.GT.1)GO TO 4
	RZ=RN(L+7)
	IF(LDGR.NE.JLDGR)JLDGR=0
C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
	LDGR=0
	JK=K
	DO 32 JJ=JK+1,N+1
	K=JJ
	RB=R(1,JJ)-R(1,JJ-1)
	IF(RB.GT.0.1)GO TO 320
C  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
	R(1,JJ)=R(1,JJ-1)
	GO TO 32
320	IF(RB.GT.RSP)GO TO 35
32	CONTINUE
C  FOUND HOW MANY MEMBERS TO CHORD.
35	RB=0
	K=K-1
	RQ=0
125	RC=ABS(RN(L+4))
	
	IF(RC.LT.60)GO TO 637
	IF(RC.LT.180)RY=.6
C  FOUND A MINI-NOTE

637	RSDF=0
	IF(RA.EQ.1)GO TO 437
C JUMP IF NOTE
	RDF=-1
C NOW IT'S ANYTHING BUT A NOTE
	GO TO 137
437	IF(RL.LT.8)GO TO 237
C JUMP IF THERE IS NOT P10 TO LOOK AT
	RW=RN(L+10)
C PUT P10 INTO RW
	GO TO 337
237	RW=0
337	IF(RDF.LT.0)GO TO 537
C JUMP IF PREVIOUS WAS NOT A NOTE
	IF(RW.EQ.RDF)GO TO 137
C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
	RSDF=-1
537	RDF=RW
C SAVE STAFF INFO FOR NEXT TIME AROUND.

137	DO 37 JJ=JK,K
C*******	IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
	JR=IR(2,JJ)
	RW=AMOD(RN(JR+4),100.)
	IF(RW.GT.12)GO TO 277
	IF(RW.GE.2)GO TO 38
277	LDGR=-1
	IF(RW.GT.11)LDGR=1
	IF(JLDGR.EQ.LDGR)GO TO 36
	JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
	GO TO 38
36	IF(RD.GE.1.5)GO TO 38
	RD=1.5
	RQ=RD
38	IF(RB.GT.2)GO TO 222
C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
	RZZ=RN(JR+7)
	RE=RN(JR+5)
	IF(RB.GE.2)GO TO 477
	RC=1.5
	IF(RZZ.LT.10)GO TO 378
	IF(RZZ.GE.20)RC=3.
C   10=DOT, 20=DOUBLE DOT
	GO TO 377
378	IF(RE.GE.20)GO TO 477
	IF(AMOD(RZZ,10.).EQ.0)GO TO 477
377	RB=RC+EXTEN(RZZ)
C  SPACE FOR DOT OR TAIL(IF STEM UP)
477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
C  FOR CHORD TONES ON RIGHT OF STEM UP.
C  LOOKS THROUGH ALL NOTES OF A CHORD.
222	RC=AMOD(RE,10.0)
	IF(RC.EQ.0)GO TO 37 
C  JUMP IF NO ACCIS.  NOW SEE IF THERE'S SPACE FOR ACCI.
	IF(RN(JIR+1).NE.1)GO TO 425
C*	RX=0
C*	IF(RN(JR).GE.8)RX=RN(JR+10)
C*	RXX=0
C*	IF(RN(JIR).GE.8)RXX=RN(JIR+10)
C*	RDF=0
C*	IF(RX.NE.RXX)RDF=100.
C SAVE INFO ON NOTES ON DIFF. STAVES.
C*	IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
C JIR IS POINTER TO PREVIOUS ITEM.  SKIP IF NOT A NOTE.
	KX=RC
C KX=ACCI ON CURRENT NOTE
	RD=1 
C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
	RX=RN(L+4)
	RXX=ABS(RX)
C THIS NOTE
577	IF(RXX.LT.80)GO TO 677
C FIND MINIS, HARMONICS, ETC.
	RXX=RXX-100
	GO TO 577
677	IF(RX)RXX=-RXX
	RX=RXX
	RDIF=RN(JIR+4)
	RXX=ABS(RDIF)
777	IF(RXX.LT.80)GO TO 877
C FIND MINIS, HARMONICS, ETC.
	RXX=RXX-100
	GO TO 777
877	IF(RDIF)RXX=-RXX

	RDIF=RX-RXX
C HEIGHT DIFF.  JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
	RX=3
	JSTM=RN(JIR+5)/10.0 
C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
	IF(RDIF.GT.0)GO TO 427
C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
	IF(JSTM.NE.2)GO TO 424
	IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL.  THEN WE NEED SPACE.
424	IF(KX.NE.2)RX=5
	GO TO 428
427	IF(KX.EQ.2)RX=4
C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
428	IF(ABS(RDIF).LT.RX)GO TO 425
	IF(RDIF)GO TO 426 
C JUMP IF THIS NOTE IS LOWER THAN PREV.
	IF(JSTM.NE.1)GO TO 426 
C NO  BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.

425	RW=2.8
	IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
CATCHES DOUBLE FLAT (=4)
   	RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425	RD=2*RY+EXTEN(RE)
426	IF(RQ.GT.RD)RD=RQ
	RQ=RD
C  FUNCT. EXTEN=AMOD(X,1.)*10.
37 	CONTINUE

	IF(RY.NE.1)RB=RB-.5*RJSZ
C  MINI NOTES NEED LESS SPACE
250	IF(RSDF)GO TO 17
	ACCX=0
CC	RC=0
 	JIR=JX+2
	IF(JIR.GE.N)GO TO 25
	RW=R(1,JIR-1)

	DO 132 JJ=JIR,N  
	IF(RW.NE.R(1,JJ))GO TO 25
	KX=IR(2,JJ)
C  GET POINTER
	IF(RN(KX+1).NE.1)GO TO 25
C  ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
CC	RE=ABS(RN(KX+6))
CC	IF(RE.GE.10)RC=-2.6
CC	IF(RE.EQ.20)RC=-RC
	RC=OTHSID(RN,KX)
	RE=AMOD(RN(KX+5),10.0)
C  FIND AN ACCI
	IF(RE.GE.1)RC=RC+2
	IF(IFIX(RE).EQ.4)RC=RC+2
C  FOUND AN ACCI    RE=4=DOUBLE FLAT
	RC=AMOD(RE,1.0)*10.0+RC
C  ADD ANY EXTENSION TO THE LEFT
	IF(RC.GT.ACCX)ACCX=RC
CC	RC=0
	IF(ACCX.GT.RD)RD=ACCX
132	CONTINUE
	GO TO 25

4	IF(RA.NE.2)GO TO 33
C  NEXT FOR DOTTED RESTS - IN P6
	IF(RL.GE.4)RB=RN(L+6)*1.5
C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
	GO TO 250
33	IF(RA.NE.3)GO TO 29
	RB=3
	IF(RN(L+4).GT.80)RB=1.5
C  CHECK ON SIZE NEEDED FOR CLEFS.  >80 = MINICLEF
29	IF(RA.NE.4)GO TO 26
C BAR LINES
	RB=-RJSZ/2
	RD=.9
	KX=RN(L+4)/1000.
	IF(KX.LE.0.)GO TO 25
	RD=RD+1.2
C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
	IF(RL.LT.3)GO TO 25
	IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
	RB=-RB/RBX
129	IF(KX.GE.2)RB=RBZ*RB
C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
	GO TO 25

26	IF(RA.NE.18)GO TO 30
C METER
	RC=0
	IF(RL.GE.7)RC=9
C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
	RB=-1
	RD=1
	IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
C  CHECKS FOR 2-DIGIT METERS
	RD=2
	RB=0
31	RB=RB+RC
	GO TO 25
30	IF(RA.NE.17)GO TO 17
C KSIG
	RX=ABS(RX)
	IF(RX.GE.100)RX=RX-100
C  +100 FOR NATURALS AS KEYSIG.
	RB=2*(RX-1)-2
C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
	RD=2
25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
17	RC=(RB+RJSZ)*RSZ
C  RJSZ=DEFAULT SIZE
	JIR=L
C SAVE THE POINTER FOR ACCI. CHECK AT 110
	JX=K
	R(2,JX)=RC
3	IF(K.LT.N)GO TO 22
	RA=R(1,1)
	RB=R(2,1)

	DO 13 KX=2,JX
	RE=R(1,KX)
C  POS. BEFORE SHIFTING
	IF(ABS(RE-RA).GT..5)GO TO 14
	IF(R(2,KX).GT.RB)GO TO 16
C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
	GO TO 13
C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
14	RD=RA+RB-RE
	IF(RD.LE.0)GO TO 16
C  THERE'S ENOUGH ROOM
	ROV=ROV+RD
140	R4=RE+RSPC-.001
	R5=10000
	R8=RD
	R9=0
C  GO EXPAND IT
	IF(R(2,KX).EQ.0)GO TO 15
	CALL MOVIT(RN,NO,R4,R5,R8,R9)
C????	IF(R2.LE.4)GO TO 15
C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
	IF(R2.LE.7)GO TO 15
	R5=R4
	R4=RA+.001+RSPC
	R8=R4
	R9=R5+RD-.001
C  FOR ITEMS ON OTHER LINES.
	CALL MOVIT(RN,NO,R4,R5,R8,R9)
15	RSPC=RSPC+RD
C  RSPC SAVES TOTAL SPACE ADDED
16	RB=R(2,KX)
13	RA=RE
11	CONTINUE
	END

	FUNCTION OTHSID(RN,J)
	DIMENSION RN(1)
	OTHSID=0
	A=ABS(RN(J+6))
	IF(A.GE.10)OTHSID=-2.6
C  OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
	IF(A.GE.20)OTHSID=-OTHSID
	END